ABCDEFGHIJKLMNOPQRSTVWXYZ abcdefghijklmnopqrstuvwxyz 🐒📊🚀

now I know my ABC’s, what’s next?

library(statexpress)
library(tidyverse)

update_geom_defaults(GeomPoint, aes(size = from_theme(pointsize * 3)))

#' @export
aes_default <- function(default = aes(x = 0)) {

  structure(
    list(
         default_spec = default), 
    class = "aes_default"
    )

}


#' @import ggplot2
#' @importFrom ggplot2 ggplot_add
#' @export
ggplot_add.aes_default <- function(object, plot, object_name) {
  
  if(is.null(plot$mapping[[names(object$default_spec)]])){
   plot <-  plot + object$default_spec
  }

  plot

}
encode <- function(color, ...){
  aes(color = {{color}}, fill = {{color}}, ...) 
}

use <- encode


use_x <- function(x){list(aes(x = {{x}}))}
use_y <- function(y){list(aes(y = {{y}}))}


plot_data <- ggplot
use_weight <- function(weight){aes(weight = {{weight}})}
use_area <- function(area){aes(weight = {{area}})}
use_rows <- function(rows, cols, ...){facet_grid(rows = vars({{rows}}), cols = vars({{cols}}), ...)}

use_columns <- function(cols, rows, ...){facet_grid(rows = vars({{rows}}), cols = vars({{cols}}), ...)}
use_rows_columns <- function(rows, cols, ...){facet_grid(rows = vars({{rows}}), cols = vars({{cols}}), ...)}
use_wrap <- function(wrap, ...){facet_wrap(facets = vars({{wrap}}), ...)}
use_size <- function(size){aes(size = {{size}})}
use_shape <- function(shape){aes(shape = {{shape}})}
use_color <- function(color){aes(fill = {{color}})}
set_color <- function(color){aes(fill = I(color))}
use_color_line <- function(color){aes(color = {{color}})}
use_chart_point <- function(...){qlayer(geom = qproto_update(GeomPoint, aes(shape = 21), 
                                                         required_aes = c()),
                                    stat = qstat(function(data, scales){data$x <- data$x %||% 0 ; data$y <- data$y %||% 0; data}), ...)}


data <- function(data){ggplot(data |> remove_missing()) + theme_classic(ink = "darkgrey", paper = "whitesmoke", base_size = 18)}
chart_jitter <- geom_jitter

chart_heat <- function(...){list(
  qlayer(geom = GeomTile, 
         stat = qproto_update(StatSum, aes(fill = after_stat(n), size = NULL)), ...),
  scale_fill_gradientn(colors = c("blue", "white", "yellow", "orange", "red")),
  theme(panel.grid.minor = element_line(color = "darkgrey")))
}



title <- function(title){labs(title = title)}
subtitle <- function(subtitle){labs(subtitle = subtitle)}
caption <- function(caption){labs(caption = caption)}
tag <- function(tag){labs(tag = tag)}

stamp_picture <- function(picture = "🙂", x = I(.5), y = I(.5), ...){
  
  annotate(geom = GeomText, label = picture, x = x, y = y, ...)
  
}

pie of pets

chart_pie <- function(...){
  
  list(
  
  geom_bar(position = "fill", width = 1, show.legend = F, ...),
  # add defaults that bar doesn't usually include
  aes_default(aes(y = .5)), 
  aes_default(aes(fill = "All")),
  aes_default(aes(weight = 1)),
  aes_default(aes(color = from_theme(paper))),
  # add labels
  stat_count(geom = GeomLabel, color = "transparent",
             position = position_fill(vjust = .5),
             aes(label = after_stat(fill), 
                 y = .9, 
                 # group = after_stat(fill)
                 ), alpha = 0,
             show.legend = F,
             size = 30
             ),
  coord_polar(),
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_blank(),
        axis.title = element_blank()),
  labs(fill = NULL)
  
  )
  
}

theme_kids <- theme_classic(paper = "whitesmoke", 
              ink = "darkgrey", 
              base_size = 30,
              base_family = "Comic Sans MS") 

theme_set(theme_kids)




pets_data <- data.frame(pets = c("🐱", "🐶", "🦚", "🐠", "🐰"), 
                   number_of_pets = c(30, 25, 10, 15, 5)) |> 
  mutate(pets = fct_infreq(pets, number_of_pets) |> fct_rev())
pets_data
#>   pets number_of_pets
#> 1   🐱             30
#> 2   🐶             25
#> 3   🦚             10
#> 4   🐠             15
#> 5   🐰              5

ggplot(pets_data) +
  chart_pie() + 
  use_color(pets) + 
  use_area(number_of_pets)

A scatter of crustaceans

library(tidyverse)
types <- c("🦐", "🦀")
set.seed(1234)
ocean_table <- cars |> 
  rename(size = dist) |>
  mutate(type = c(
    rep("🦐", 20),
    sample(types, 10, replace = T),
    rep("🦀", 20))) |>
  sample_frac()


GeomPointFill <-qproto_update(GeomPoint, aes(shape = 21),
                              required_aes = c())


library(statexpress)
chart_point <- function(...){
  list(
  qlayer(geom = GeomPointFill,
         stat = qstat(function(data, scales){
           # data$shape <- data$shape %||% data$picture
           # data$x <- data$x %||% 0 ; 
           # data$y <- data$y %||% 0; 
           data}), 
         ..., show.legend = F),
  aes_default(aes(x = 0)),
  aes_default(aes(y = 0)),
  aes_default(aes(shape = I(after_stat(picture)))),
  scale_size(range = c(2,10))
  
  )
  }


# should replace with lm xy
chart_fit_line <- function(...){
  
  geom_smooth(method = lm, ..., show.legend = F, se = F, 
              linetype = "dashed",
              aes(shape = NULL, picture = NULL))
  
}

use_picture <- function(picture){aes(shape = I({{picture}}))}
head(ocean_table)
#>   speed size type
#> 1    13   26   🦐
#> 2     7   22   🦐
#> 3    18   76   🦀
#> 4    20   32   🦀
#> 5    14   60   🦀
#> 6    15   54   🦀

ggplot(ocean_table) + 
  chart_point() +
  use_y(speed) +
  use_x(size) + 
  use_size(size) + 
  use_picture(type) + 
  chart_fit_line()

last_plot() +
  labs(x = "little                        big") +
  labs(y = "slow           fast") +
  theme(panel.background = element_rect(fill = "skyblue")) + 
  stamp_picture("🐉", 
                size = 40, 
                x = 100,
                y = 10)

A jungle bar chart… ?

theme_chart_bar <- function(){
  theme(panel.grid.minor = element_blank(), 
        panel.grid.major.x = element_blank(),
        axis.ticks.x = element_blank())
  }

chart_bar <- function(...){
  list(geom_col(...), 
       theme_chart_bar(),
       scale_y_continuous(expand = expansion(c(0, .3))),
       labs(x = NULL))
}

compute_item_stack <- function(data, scales, width = 0.2){
               
    data$shape <- data$shape %||% data$picture

    data |> 
      uncount(y) |>
      dplyr::mutate(row = row_number()) |> 
      dplyr::mutate(y = row - 
        0.5) |>
      dplyr::mutate(width = width)
    
  }

chart_item_stack <- function(...){
  
  list(
  qlayer(
    geom = GeomPointFill, 
    stat = qstat(compute_item_stack)
  ),
  qlayer(
    geom = GeomTile, 
    stat = qstat(compute_item_stack), 
    alpha = 0
  ),
  scale_y_continuous(expand = expansion(c(0, .3))),
  aes_default(aes(y = 1)),
  aes_default(aes(x = "All")),
  labs(x = NULL)
  )

  
}

ggprop.test:::compute_group_bricks
#> function (data, scales, width = 0.2) 
#> {
#>     data %>% dplyr::mutate(row = row_number()) %>% dplyr::mutate(y = row - 
#>         0.5) %>% dplyr::mutate(width = width)
#> }
#> <bytecode: 0x12624ef60>
#> <environment: namespace:ggprop.test>

jungle_table <- data.frame(tree = paste0("🌴#", 1:5), 
                     num_bunches = c(2, 5, 1, 2, 1), 
                     banana = "🍌")

jungle_table |> 
  select(x = tree, y = num_bunches, picture = banana) |>
  compute_item_stack()
#>       x picture shape row    y width
#> 1  🌴#1      🍌    🍌   1  0.5   0.2
#> 2  🌴#1      🍌    🍌   2  1.5   0.2
#> 3  🌴#2      🍌    🍌   3  2.5   0.2
#> 4  🌴#2      🍌    🍌   4  3.5   0.2
#> 5  🌴#2      🍌    🍌   5  4.5   0.2
#> 6  🌴#2      🍌    🍌   6  5.5   0.2
#> 7  🌴#2      🍌    🍌   7  6.5   0.2
#> 8  🌴#3      🍌    🍌   8  7.5   0.2
#> 9  🌴#4      🍌    🍌   9  8.5   0.2
#> 10 🌴#4      🍌    🍌  10  9.5   0.2
#> 11 🌴#5      🍌    🍌  11 10.5   0.2




# last_plot() + 
#   annotate(geom = GeomText,
#            x = I(.75), y = I(.72),
#            label = "🎈🎀🙏",
#            angle = -10,
#            size = 22,
#             )  
jungle_table
#>   tree num_bunches banana
#> 1 🌴#1           2     🍌
#> 2 🌴#2           5     🍌
#> 3 🌴#3           1     🍌
#> 4 🌴#4           2     🍌
#> 5 🌴#5           1     🍌

ggplot(jungle_table) + 
  chart_item_stack() +
  use(x = tree,
      y = num_bunches, 
      picture = banana) + # you could also use "🍌"
  chart_item_stack()



last_plot() + 
  stamp_picture("🐒",
                size = 40,
                x = I(.95),
                y = I(.15)) + 
  coord_cartesian(clip = "off")



head(jungle_table)
#>   tree num_bunches banana
#> 1 🌴#1           2     🍌
#> 2 🌴#2           5     🍌
#> 3 🌴#3           1     🍌
#> 4 🌴#4           2     🍌
#> 5 🌴#5           1     🍌

ggplot(jungle_table) + 
  encode(x = tree,
         y = num_bunches) + 
  chart_bar(fill = "gold")

Polar Bears


chart_bar_plunging <- function(...){
  list(geom_col(...), 
       theme_chart_bar(),
       scale_y_reverse(expand = expansion(c(.3, 0))),
       scale_x_discrete(position = "top"),
       labs(x = NULL),
       geom_label(vjust = 1, aes(label = after_stat(y))))
}

bears <- paste0("🐻‍❄️ #", 1:5)
depth <- c(3,5,4,6,5)

polar_bear_table <- data_frame(bears, depth)

ggplot(polar_bear_table) +
  use_x(bears) + 
  use_y(depth) +
  chart_bar_plunging(fill = "skyblue")

digging

time <- paste0(c(0, 15, 30, 45, 60), "⏱️")
num_tunnels <- c(0, 4, 5, 5.5, 5.9)
fork_and_spoon_table <- data_frame(time, num_tunnels, type = "🍴")

shovel_and_bucket_table <- data_frame(time, num_tunnels = num_tunnels * 2, type = "🪣")

paws_table <- data_frame(time, num_tunnels = num_tunnels * 3, type = "🐾")



fork_and_spoon_table |>
  bind_rows(shovel_and_bucket_table) |>
  bind_rows(paws_table) |>
ggplot() +
  use_x(time) + 
  use_y(num_tunnels) + 
  use(picture = type) +
  geom_line(aes(group = type)) +
  chart_point()

Shuttles (future work)


outer_space_data <- data.frame(shuttle = paste0("🚀 #", 1:6), fuel = c(.3,.5,.3, .8,.7, .4))

chart_part_of_full <- function(...){
  
  list(
       geom_col(color = "black", fill = "transparent", aes(y = 1)),
       geom_col(color = "black", ... )
       )
  
}

stamp_hline <- function(y = .5, linetype = "dashed", ...){
  
  geom_hline(yintercept = y, linetype = linetype, ...)
  
}
outer_space_data
#>   shuttle fuel
#> 1   🚀 #1  0.3
#> 2   🚀 #2  0.5
#> 3   🚀 #3  0.3
#> 4   🚀 #4  0.8
#> 5   🚀 #5  0.7
#> 6   🚀 #6  0.4

ggplot(outer_space_data) +
  use(x = shuttle,
      y = fuel) +
  chart_part_of_full(fill = "darkolivegreen3") +
  stamp_hline(.75)



last_plot() + 
  stamp_picture("👽",
                angle = 25,
                size = 40,
                x = I(.95),
                y = I(.15)) + 
  coord_cartesian(clip = "off")



knitr::knit_exit()